module kuty
  !
  ! LICENSE AGREEMENT:
  !
  ! You agree that we don't agree to anything.
  !
  !
  ! DISCLAIMER OF WARRANTIES:
  !
  ! This software is provided to you "AS IS," and the authors and
  ! contributors disclaim any warranty or liability obligations to you
  ! of any kind, implied or express, including but not limited to the
  ! warranties of merchantability, fitness for a particular purpose,
  ! and non-infringement.
  ! 
  implicit none
  integer,parameter::IPC_R       = int(o'000400', 8)
  integer,parameter::IPC_W       = int(o'000200', 8)
  integer,parameter::IPC_M       = int(o'010000', 8)
  integer,parameter::IPC_CREAT   = int(o'001000', 8)
  integer,parameter::IPC_EXCL    = int(o'002000', 8)
  integer,parameter::IPC_NOWAIT  = int(o'004000', 8)
  integer,parameter::IPC_PRIVATE = 0
  integer,parameter::IPC_RMID    = 0
  integer,parameter::IPC_SET     = 1
  integer,parameter::IPC_STAT    = 2
  integer,parameter::IPC_INFO    = 3
  !
  integer,parameter::SHMSZ=2147479552

  !
  integer,parameter::WNOHANG    = 1
  integer,parameter::WUNTRACED  = 2
  integer,parameter::WCONTINUED = 4

  ! checksum types
  integer,parameter::CKT_MD5    = 1
  integer,parameter::CKT_SHA1   = 2
  integer,parameter::CKT_SHA256 = 3

  type timeval
     integer tv_sec ! sec
     integer tv_usec ! usec
  end type timeval
  
  integer,parameter::SIGHUP    =  1 ! hangup */
  integer,parameter::SIGINT    =  2 ! interrupt */
  integer,parameter::SIGQUIT   =  3 ! quit */
  integer,parameter::SIGILL    =  4 ! illegal instr. (not reset when caught) */
  integer,parameter::SIGTRAP   =  5 ! trace trap (not reset when caught) */
  integer,parameter::SIGABRT   =  6 ! abort() */
  integer,parameter::SIGEMT    =  7 ! EMT instruction */
  integer,parameter::SIGFPE    =  8 ! floating point exception */
  integer,parameter::SIGKILL   =  9 ! kill (cannot be caught or ignored) */
  integer,parameter::SIGBUS    = 10 ! bus error */
  integer,parameter::SIGSEGV   = 11 ! segmentation violation */
  integer,parameter::SIGSYS    = 12 ! non-existent system call invoked */
  integer,parameter::SIGPIPE   = 13 ! write on a pipe with no one to read it */
  integer,parameter::SIGALRM   = 14 ! alarm clock */
  integer,parameter::SIGTERM   = 15 ! software termination signal from kill */
  integer,parameter::SIGURG    = 16 ! urgent condition on IO channel */
  integer,parameter::SIGSTOP   = 17 ! sendable stop signal not from tty */
  integer,parameter::SIGTSTP   = 18 ! stop signal from tty */
  integer,parameter::SIGCONT   = 19 ! continue a stopped process */
  integer,parameter::SIGCHLD   = 20 ! to parent on child stop or exit */
  integer,parameter::SIGTTIN   = 21 ! to readers pgrp upon background tty read */
  integer,parameter::SIGTTOU   = 22 ! like TTIN if (tp->t_local&LTOSTOP) */
  integer,parameter::SIGIO     = 23 ! input/output possible signal */
  integer,parameter::SIGXCPU   = 24 ! exceeded CPU time limit */
  integer,parameter::SIGXFSZ   = 25 ! exceeded file size limit */
  integer,parameter::SIGVTALRM = 26 ! virtual time alarm */
  integer,parameter::SIGPROF   = 27 ! profiling time alarm */
  integer,parameter::SIGWINCH  = 28 ! window size changes */
  integer,parameter::SIGINFO   = 29 ! information request */
  integer,parameter::SIGUSR1   = 30 ! user defined signal 1 */
  integer,parameter::SIGUSR2   = 31 ! user defined signal 2 */
  integer,parameter::SIGTHR    = 32 ! reserved by thread library. */

  !
  type rusage
     type(timeval) ru_utime !  user time used 
     type(timeval) ru_stime !  system time used 
     integer ru_maxrss      !  max resident set size 
     integer ru_ixrss       !  integral shared memory size 
     integer ru_idrss       !  integral unshared data 
     integer ru_isrss       !  integral unshared stack
     integer ru_minflt      !  page reclaims 
     integer ru_majflt      !  page faults 
     integer ru_nswap       !  swaps 
     integer ru_inblock     !  block input operations 
     integer ru_oublock     !  block output operations 
     integer ru_msgsnd      !  messages sent 
     integer ru_msgrcv      !  messages received 
     integer ru_nsignals    !  signals received 
     integer ru_nvcsw       !  voluntary context switches 
     integer ru_nivcsw      !  involuntary 
  end type rusage

  !
  type in_addr
     integer*4 s_addr
  end type in_addr

  !
  type sockaddr_in
     integer*1 sin_len
     integer*1 sin_family
     integer*2 sin_port
     type(in_addr) sin_addr
     integer*1 sin_zero(8)
  end type sockaddr_in

  !
  type timespec
     integer*8 tv_sec
     integer*8 tv_nsec
  end type timespec
  
  !
  type nstat
     integer*4 st_dev
     integer*4 st_ino
     integer*4 st_mode
     integer*4 st_nlink
     integer*4 st_uid
     integer*4 st_gid
     integer*4 st_rdev
     type(timespec) st_atimespec
     type(timespec) st_mtimespec
     type(timespec) st_ctimespec
     integer*8 st_size
     integer*8 st_blocks
     integer*4 st_blksize
     integer*4 st_flags
     integer*4 st_gen
     type(timespec) st_birthitmespec
     integer*8 pad
  end type nstat

  !
  integer,public,parameter::F_OK = 0
  integer,public,parameter::X_OK = 1
  integer,public,parameter::W_OK = 2
  integer,public,parameter::R_OK = 4


  !
  interface 
     integer function faccess(pfn,mode)
       integer,intent(in),value::pfn,mode
     end function faccess
  end interface
  interface 
     integer function geterrnoc()
     end function geterrnoc
  end interface 
  interface 
     integer function geterrnoa()
     end function geterrnoa
  end interface
 interface 
     subroutine getipstr(pstr)
       integer,intent(in),value::pstr
     end subroutine getipstr
  end interface
  interface 
     subroutine setsubnet(subnet)
       integer,intent(in),value::subnet
     end subroutine setsubnet
  end interface
  interface 
     subroutine setport(port)
       integer,intent(in),value::port
     end subroutine setport
  end interface
  interface 
     integer function shmget(key,size,flg)
       integer,intent(in),value::key,size,flg
     end function shmget
  end interface
  interface 
     integer function shmat(shmid,shmaddr,flg)
       integer,intent(in),value::shmid,shmaddr,flg
     end function shmat
  end interface
  interface 
     integer function shmdt(shmaddr)
       integer,intent(in),value::shmaddr
     end function shmdt
  end interface
  interface 
     integer function shmctl(shmid,cmd,pbuf)
       integer,intent(in),value::shmid,cmd,pbuf
     end function shmctl
  end interface
  interface 
     integer function fork()
     end function fork
  end interface
  interface
     integer function wait4(pid,pstatus,options,prusage)
       integer,intent(in),value::pid,pstatus,options,prusage
     end function wait4
  end interface
  interface 
     integer function waitpid(pid,status,options)
       integer,intent(in),value::pid,options
       integer,intent(in)::status
     end function waitpid
  end interface
  interface
     integer function kill(pid,sig)
       integer,intent(in),value::pid,sig
     end function kill
  end interface
  interface
     integer function opentcp(port)
       integer,intent(in),value::port
     end function opentcp
  end interface
  interface
     integer function listenaccept(s)
       integer,intent(in),value::s
     end function listenaccept
  end interface
  interface 
     integer function recv(s,pbuf)
       integer,intent(in),value::s,pbuf
     end function recv
  end interface
  interface
     subroutine closetcp(s,s2)
       integer,intent(in),value::s,s2
     end subroutine closetcp
  end interface
  interface
     integer function recvdata(s,len,pbuf)
       integer,intent(in),value::s,len,pbuf
     end function recvdata
  end interface
  interface 
     integer function send(s,pbuf,len)
       integer,intent(in),value::s,pbuf,len
     end function send
  end interface
  interface
     subroutine close(s)
       integer,intent(in),value::s
     end subroutine close
  end interface
  interface ! for debug
     integer function check(pimg,lenimg,res)
       integer,intent(in),value::pimg,lenimg,res
     end function check
  end interface
  interface 
     subroutine c2fstr(pstr,lenstr)
       integer,intent(in),value::pstr,lenstr
     end subroutine c2fstr
  end interface
  interface
     subroutine md5data(pdata,len,pres)
       integer,intent(in),value::pdata,len,pres
     end subroutine md5data
  end interface
  interface
     subroutine sha1data(pdata,len,pres)
       integer,intent(in),value::pdata,len,pres
     end subroutine sha1data
  end interface
  interface
     subroutine sha256data(pdata,len,pres)
       integer,intent(in),value::pdata,len,pres
     end subroutine sha256data
  end interface
  interface
     subroutine setup_SIGCHLD
     end subroutine setup_SIGCHLD
  end interface
  interface
     subroutine setup_SIGTERM(ptermproc)
       integer,intent(in),value::ptermproc
     end subroutine setup_SIGTERM
  end interface
  interface
     subroutine write(fd,str)
       integer,intent(in),value::fd
       character*(*),intent(in)::str
     end subroutine write
  end interface
  interface 
     integer function timec()
     end function timec
  end interface
  interface
     integer function isRunning(pid)
       integer,intent(in),value::pid
     end function isRunning
  end interface
  interface 
     integer function cpu(type)
       integer,intent(in),value::type
     end function cpu
  end interface
  interface 
     integer function f2b(file,pbuf)
       character*(*),intent(in)::file
       integer,intent(in),value::pbuf
     end function f2b
  end interface
  interface 
     integer function stat(ppath, pub)
       integer,intent(in),value::ppath,pub
     end function stat
  end interface
  !
contains
  !
  integer function ftokwpid(path,id,pid)
    character*(*),intent(in)::path
    integer,intent(in)::id,pid
    ftokwpid=ftok(path,ior(ishft(id,24),pid)) ! <<<<<<<<<<<
  end function ftokwpid
  !
  integer function ftok(path,id)
    use suty
    character*(*),intent(in)::path
    integer,intent(in)::id
    type(nstat) ns
    integer len,istat
    integer*1,allocatable::b(:)
    ftok=-1
    len=len_trim(path)
    if(len==0) return
    allocate(b(len+1))
    b=0_1
    call mcps(loc(b),loc(path),len)
    istat=stat(loc(b),loc(ns))
    if(istat/=0) return
    ftok=int(ior(ior(ishft(id,24),&
         ishft(iand(ns%st_dev,z"ff"),16)),&
         iand(ns%st_ino,z"ffff")),8)
  end function ftok
!!$  !
!!$  integer function addi(a,b)
!!$    integer,intent(in)::a,b
!!$    addi=a+b
!!$  end function addi
!!$  real function addr(a,b)
!!$    real,intent(in)::a,b
!!$    addr=a+b
!!$  end function addr
  !
  character*256 function get_cksum(type,size,data) result(ckstr)
    integer,intent(in)::type
    integer,intent(in)::size
    integer*1,intent(in)::data(size)
!    character*256 ckstr
    select case(type)
    case(CKT_MD5)
       call md5data(loc(data),size,loc(ckstr))
    case(CKT_SHA1)
       call sha1data(loc(data),size,loc(ckstr))
    case(CKT_SHA256)
       call sha256data(loc(data),size,loc(ckstr))
    end select
    call c2fstr(loc(ckstr),len(ckstr))
  end function get_cksum
  !
  subroutine write1(str)
    character*(*),intent(in)::str
    call write(1,str)!,len_trim(str))
  end subroutine write1

  !
  integer function fsize(f)
    use suty
    character*(*),intent(in)::f    
    type(nstat) ns
    integer istat,len
    integer*1,allocatable::b(:)
    fsize=-1
    len=len_trim(f)
    if(len==0) return
    allocate(b(len+1))
    b=0_1
    call mcps(loc(b),loc(f),len)
    istat=stat(loc(b),loc(ns))
    if(istat/=0) return
    fsize=ns%st_size
!!$    integer buf(13),istat
!!$    call stat(f,buf,istat)
!!$    if(istat==0) then
!!$       fsize=buf(8)
!!$    else
!!$       fsize=-1
!!$    end if
  end function fsize
  !
end module kuty
